home *** CD-ROM | disk | FTP | other *** search
VERSION 2.00 Begin Form MsgBxGen BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "MsgBox Editor 2.1" ClientHeight = 4428 ClientLeft = 1260 ClientTop = 1692 ClientWidth = 8148 Height = 4800 Icon = _MSGBOX.FRX:0000 Left = 1212 LinkMode = 1 'Source LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 4428 ScaleWidth = 8148 Top = 1368 Width = 8244 Begin SSFrame Frame3D1 Caption = "&Icon Display Options" Font3D = 0 'None ForeColor = &H00000000& Height = 4212 Left = 60 TabIndex = 0 Top = 60 Width = 2832 Begin PictureBox IconPic BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 1095 Index = 32 Left = 1500 Picture = _MSGBOX.FRX:0302 ScaleHeight = 1092 ScaleWidth = 1212 TabIndex = 2 Top = 240 Width = 1215 Begin Label IcPicLabel BackColor = &H00C0C0C0& Caption = "Questions for the User" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Index = 32 Left = 120 TabIndex = 3 Top = 600 Width = 975 End End Begin PictureBox IconPic BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 1095 Index = 16 Left = 180 Picture = _MSGBOX.FRX:0604 ScaleHeight = 1092 ScaleWidth = 1212 TabIndex = 6 Top = 1500 Width = 1215 Begin Label IcPicLabel BackColor = &H00C0C0C0& Caption = "Critical Error Messages" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Index = 16 Left = 120 TabIndex = 7 Top = 600 Width = 975 End End Begin PictureBox IconPic BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 1095 Index = 64 Left = 1500 Picture = _MSGBOX.FRX:0906 ScaleHeight = 1092 ScaleWidth = 1212 TabIndex = 4 Top = 1500 Width = 1215 Begin Label IcPicLabel BackColor = &H00C0C0C0& Caption = "Information for the User" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Index = 64 Left = 120 TabIndex = 5 Top = 600 Width = 975 End End Begin PictureBox IconPic BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 1095 Index = 48 Left = 180 Picture = _MSGBOX.FRX:0C08 ScaleHeight = 1092 ScaleWidth = 1212 TabIndex = 8 Top = 2880 Width = 1215 Begin Label IcPicLabel BackColor = &H00C0C0C0& Caption = "Important Messages" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Index = 48 Left = 120 TabIndex = 9 Top = 600 Width = 975 End End Begin PictureBox IconPic BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 1095 Index = 0 Left = 1500 ScaleHeight = 1092 ScaleWidth = 1212 TabIndex = 10 Top = 2880 Width = 1215 Begin Label IcPicLabel BackColor = &H00C0C0C0& Caption = "No Icon Displayed" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Index = 0 Left = 240 TabIndex = 11 Top = 600 Width = 975 End End Begin Label Label1 BackColor = &H00C0C0C0& Caption = "Click on the icon of your choice to place it on your MsgBox" Height = 1092 Left = 180 TabIndex = 1 Top = 240 Width = 1212 End End Begin SSFrame Frame3D2 Caption = "&Button Display Options" Font3D = 0 'None ForeColor = &H00000000& Height = 1992 Left = 3000 TabIndex = 12 Top = 60 Width = 3372 Begin SSOption ButOpt3D Caption = "Ok Button Only" Font3D = 0 'None Height = 255 Index = 0 Left = 120 TabIndex = 13 Top = 360 Width = 3135 End Begin SSOption ButOpt3D Caption = "Ok and Cancel Buttons" Font3D = 0 'None Height = 255 Index = 1 Left = 120 TabIndex = 14 TabStop = 0 'False Top = 600 Width = 3135 End Begin SSOption ButOpt3D Caption = "Abort, Retry, and Ignore Buttons" Font3D = 0 'None Height = 255 Index = 2 Left = 120 TabIndex = 15 TabStop = 0 'False Top = 840 Width = 3135 End Begin SSOption ButOpt3D Caption = "Yes, No, and Cancel Buttons" Font3D = 0 'None Height = 255 Index = 3 Left = 120 TabIndex = 16 TabStop = 0 'False Top = 1080 Width = 3135 End Begin SSOption ButOpt3D Caption = "Yes and No Buttons" Font3D = 0 'None Height = 255 Index = 4 Left = 120 TabIndex = 17 TabStop = 0 'False Top = 1320 Width = 3135 End Begin SSOption ButOpt3D Caption = "Retry and Cancel Buttons" Font3D = 0 'None Height = 255 Index = 5 Left = 120 TabIndex = 18 TabStop = 0 'False Top = 1560 Width = 3135 End End Begin SSFrame Frame3D3 Caption = "Call &Type" Font3D = 0 'None ForeColor = &H00000000& Height = 1152 Left = 6480 TabIndex = 19 Top = 60 Width = 1572 Begin SSOption CodeOpt3D Caption = "Statement" Font3D = 0 'None Height = 252 Index = 0 Left = 120 TabIndex = 20 Top = 360 Value = -1 'True Width = 1332 End Begin SSOption CodeOpt3D Caption = "Function" Font3D = 0 'None Height = 252 Index = 1 Left = 120 TabIndex = 21 TabStop = 0 'False Top = 660 Width = 1332 End End Begin SSFrame Frame3D4 Caption = "&Default Button Option" Font3D = 0 'None ForeColor = &H00000000& Height = 1152 Left = 3360 TabIndex = 22 Top = 2160 Width = 2172 Begin SSOption optDefButton Caption = "&1st Button" Font3D = 0 'None Height = 252 Index = 0 Left = 360 TabIndex = 23 Top = 300 Value = -1 'True Width = 1212 End Begin SSOption optDefButton Caption = "&2nd Button" Font3D = 0 'None Height = 252 Index = 256 Left = 360 TabIndex = 24 TabStop = 0 'False Top = 540 Width = 1212 End Begin SSOption optDefButton Caption = "&3rd Button" Font3D = 0 'None Height = 252 Index = 512 Left = 360 TabIndex = 25 TabStop = 0 'False Top = 780 Width = 1212 End End Begin SSCommand AboutCommand3D Caption = "&About..." Font3D = 0 'None FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 312 Left = 6480 TabIndex = 33 Top = 1260 Width = 1572 End Begin SSCommand cmdCodeOpts Caption = "&Code Options..." Font3D = 0 'None FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 312 Left = 6480 TabIndex = 34 Top = 1620 Width = 1572 End Begin CommandButton ExitCtl Cancel = -1 'True Caption = "E&xit" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 312 Left = 6480 TabIndex = 35 Top = 1980 Width = 1572 End Begin SSFrame Frame3D5 Caption = "Modal" Font3D = 0 'None ForeColor = &H00000000& Height = 912 Left = 5880 TabIndex = 26 Top = 2400 Width = 1632 Begin SSOption optModal Caption = "Application" Font3D = 0 'None Height = 252 Index = 0 Left = 120 TabIndex = 27 Top = 300 Value = -1 'True Width = 1392 End Begin SSOption optModal Caption = "System" Font3D = 0 'None Height = 252 Index = 4096 Left = 120 TabIndex = 28 TabStop = 0 'False Top = 540 Width = 1392 End End Begin CommandButton EditCtl Caption = "&Edit Message Box Title and Contents" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 492 Left = 3000 TabIndex = 29 Top = 3420 Width = 5052 End Begin CommandButton cmdPrevCode Caption = "&Preview Code" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 372 Left = 3000 TabIndex = 30 Top = 3960 Width = 1692 End Begin CommandButton cmdPreview Caption = "&Preview MsgBox" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 372 Left = 4740 TabIndex = 31 Top = 3960 Width = 1932 End Begin CommandButton CopyCtl Caption = "&Clipboard" Default = -1 'True FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.6 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 372 Left = 6720 TabIndex = 32 Top = 3960 Width = 1332 End Option Explicit Sub AboutCommand3D_Click () MBAbout.Show 1 End Sub Sub ButOpt3D_Click (Index As Integer, Value As Integer) ' Set Global to the type of buttons to show gintButtonstyle = Index ' Set Default button to appropate setting Select Case Index Case 0 ' Only one button in the MsgBox optDefButton(0).Value = True optDefButton(256).Enabled = False optDefButton(512).Enabled = False Case 1, 4, 5 ' Two buttons in the MsgBox optDefButton(256).Enabled = True If gintDefault = 512 Then optDefButton(0).Value = True End If optDefButton(512).Enabled = False Case 2, 3 ' Three buttons in the MsgBox optDefButton(256).Enabled = True optDefButton(512).Enabled = True End Select End Sub Sub cmdCodeOpts_Click () ' Show the Code Options form frmCodeOpts.Show 1 ' Unload the Code Options form all done with it Unload frmCodeOpts End Sub Sub cmdPrevCode_Click () Load frmPrevCode frmPrevCode!txtCodeView.Text = GetMsgBoxCode() frmPrevCode.Show 1 Unload frmPrevCode End Sub Sub cmdPreview_Click () 'Dim pstrCode As String ' This is neet code to have some times 'pstrCode = GetMsgBoxCode() 'MsgBox pstrCode, 0, "MsgBox Editor" Dim pstrMsgBoxIni As String Dim pstr3DUse As String pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pstr3DUse = ReadIni("Code Options", "Use 3D", "Never", pstrMsgBoxIni) If pstr3DUse <> "None" Then Call Turn3dOnOff End If If gstrTheTitle <> "" Then MsgBox gstrRawMessage, gintDefault + gintIconstyle + gintButtonstyle + gintModal, gstrTheTitle Else ' No title selected so we add a good default titel MsgBox gstrRawMessage, gintDefault + gintIconstyle + gintButtonstyle + gintModal, "Project1" End If If pstr3DUse <> "None" Then Call Turn3dOnOff End If End Sub Sub CopyCtl_Click () Dim pintTheAnswer As Integer ' Put all code on the clipboard Clipboard.SetText GetMsgBoxCode(), 1 ' Ask if the program should shut down or just mimimiz it's self Call Turn3dOnOff pintTheAnswer = MsgBox("Iconize this program (No means exit!) ?", 36, "MsgBox Editor") Call Turn3dOnOff If pintTheAnswer = 6 Then 'Answered Yes WindowState = MINIMIZED Else 'Answered No Unload Me End If End Sub Sub EditCtl_Click () ' Show MsgEdit form to allow for editing of ' the titel and the message MsgEdit.Show 1 ' Unload the MsgEdit form all done for now Unload MsgEdit ' Set the focus to the Clipboard button ' Maby this sgould to to the Preview button? Me.CopyCtl.SetFocus End Sub Sub ExitCtl_Click () ' Unload the form to close the app Unload Me End Sub Sub Form_Load () Dim pstrMsgBoxIni As String Dim pintTop As Integer Dim pintLeft As Integer Dim pintNoIni As Integer screen.MousePointer = 11 ' Initialize variables and controls gintDefault = 0 gintIconstyle = 0 gintButtonstyle = 0 ButOpt3D(gintButtonstyle).Value = True MsgBxGen.WindowState = 0 gstrCR = Chr$(13) & Chr$(10) gstrQ = Chr$(34) gstrTheMessage = gstrQ ' Get the app's ini file and location pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pintTop = Val(ReadIni("MsgBox", "Top", "-10000", pstrMsgBoxIni)) If pintTop = -10000 Then ' See if no top entry in the ini file the ' assumption is there is no ini file if true pintNoIni = True ' Set procedure flag to true pintTop = (screen.Height - Me.Height) / 2 ' Set the top of the form End If pintLeft = Val(ReadIni("MsgBox", "Left", Str((screen.Width - Me.Width) / 2), pstrMsgBoxIni)) Me.Move pintLeft, pintTop screen.MousePointer = 0 ' If this is the first run (or there is no ini file) If pintNoIni Then ' Save the default top and left Call SaveIni("MsgBox", "Top", Trim(Str(Me.Top)), pstrMsgBoxIni) Call SaveIni("MsgBox", "Left", Trim(Str(Me.Left)), pstrMsgBoxIni) Call AboutCommand3D_Click ' Show the about screen End If End Sub Sub Form_Unload (Cancel As Integer) Dim pstrMsgBoxIni As String ' Get the app's ini file and location pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") ' If the window is not minimized save the postion of it If Me.WindowState <> 1 Then Call SaveIni("MsgBox", "Top", Trim(Str(Me.Top)), pstrMsgBoxIni) Call SaveIni("MsgBox", "Left", Trim(Str(Me.Left)), pstrMsgBoxIni) End If End Sub Function Get3DCode (Indent As String) As String Dim pstrMsgBoxIni As String Dim pstr3DUse As String Dim pstr3DSub As String Dim pstrIncCode As String Dim pstr3DSubName As String ' I want to make this whole sub changeable through a data file or some other way??? ' Suggestions are welcome pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pstr3DUse = ReadIni("Code Options", "Use 3D", "Never", pstrMsgBoxIni) pstrIncCode = ReadIni("Code Options", "Inc 3D Code", "0", pstrMsgBoxIni) pstr3DSubName = ReadIni("Code Options", "3D Code Name", "Turn3dOnOff", pstrMsgBoxIni) ' Can not set form UI need to change If pstr3DUse <> "Never" And Val(pstrIncCode) Then pstr3DSub = gstrCR & gstrCR & "' Procedure: " & pstr3DSubName & gstrCR pstr3DSub = pstr3DSub & "' Arguments: None" & gstrCR pstr3DSub = pstr3DSub & "'" & gstrCR pstr3DSub = pstr3DSub & "' Note: This sub will turn the 3d of the CTL3D.DLL or CTL3DV2.DLL on and off." & gstrCR pstr3DSub = pstr3DSub & "' This can be used throughout an app (saffer) or just once to trun it" & gstrCR pstr3DSub = pstr3DSub & "' on then once to turn it off." & gstrCR pstr3DSub = pstr3DSub & "'" & gstrCR pstr3DSub = pstr3DSub & "Sub " & pstr3DSubName & "()" & gstrCR & gstrCR pstr3DSub = pstr3DSub & Indent & "Static pintInst as integer ' Holds the inst handle of the app" & gstrCR pstr3DSub = pstr3DSub & Indent & "Static pint3dOn as integer ' Holds flag of if 3d is on (true) or off (false)" & gstrCR pstr3DSub = pstr3DSub & Indent & "Dim pintTemp as integer ' Temp not to be used" & gstrCR & gstrCR pstr3DSub = pstr3DSub & Indent & "If pintInst = 0 Then ' If no inst handle retreved yet" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "' Get an inst handle for this app" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "pintInst = GetModuleHandle((app.EXEName))" & gstrCR pstr3DSub = pstr3DSub & Indent & "End If" & gstrCR & gstrCR pstr3DSub = pstr3DSub & Indent & "If pint3dOn Then ' If pint3dOn flag is true (3d is on)" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "' Unregister 3d (turn 3d off)" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "pintTemp = Ctl3dUnregister(pintInst)" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "pint3dOn = False" & gstrCR pstr3DSub = pstr3DSub & Indent & "Else" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "' Register 3d (turn 3d on)" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "pintTemp = Ctl3dRegister(pintInst)" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "pintTemp = Ctl3dAutoSubClass(pintInst)" & gstrCR pstr3DSub = pstr3DSub & Indent & Indent & "pint3dOn = True" & gstrCR pstr3DSub = pstr3DSub & Indent & "End if" & gstrCR & gstrCR pstr3DSub = pstr3DSub & "End Sub" End If If pstr3DUse = "Startup" Then pstr3DSub = "' code and your ending code ie Form_Load and Form_Unload" & gstrCR & gstrCR & gstrCR & pstr3DSub pstr3DSub = "' You will need to add calles to the next sub in your starting" & gstrCR & pstr3DSub pstr3DSub = gstrCR & gstrCR & pstr3DSub End If Get3DCode = pstr3DSub End Function Function Get3DDecl () As String Dim pstrDeclares As String Dim pstrMsgBoxIni As String Dim pstrInc3DDecl As String pstrDeclares = "" pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pstrInc3DDecl = ReadIni("Code Options", "Inc 3D Decl", "0", pstrMsgBoxIni) If Val(pstrInc3DDecl) = True Then pstrDeclares = "' Declare the fun needed to get the apps module handle" & gstrCR pstrDeclares = pstrDeclares & "Declare Function GetModuleHandle Lib " & Chr(34) & "Kernel" & Chr(34) & " (ByVal lpModuleName As String) As Integer" & gstrCR & gstrCR pstrDeclares = pstrDeclares & "' Declares to make CTL3D.DLL work" & gstrCR pstrDeclares = pstrDeclares & "Declare Function Ctl3dRegister Lib " & Chr(34) & "CTL3D.DLL" & Chr(34) & " (ByVal hInstance As Integer) As Integer" & gstrCR pstrDeclares = pstrDeclares & "Declare Function Ctl3dAutoSubClass Lib " & Chr(34) & "CTL3D.DLL" & Chr(34) & " (ByVal hInstance As Integer) As Integer" & gstrCR pstrDeclares = pstrDeclares & "Declare Function Ctl3dUnregister Lib " & Chr(34) & "CTL3D.DLL" & Chr(34) & " (ByVal hInstance As Integer) As Integer" & gstrCR & gstrCR pstrDeclares = pstrDeclares & "' Declares to make CTL3DV2.DLL work" & gstrCR pstrDeclares = pstrDeclares & "'Declare Function Ctl3dRegister Lib " & Chr(34) & "CTL3DV2.DLL" & Chr(34) & " (ByVal hInstance As Integer) As Integer" & gstrCR pstrDeclares = pstrDeclares & "'Declare Function Ctl3dAutoSubClass Lib " & Chr(34) & "CTL3DV2.DLL" & Chr(34) & " (ByVal hInstance As Integer) As Integer" & gstrCR pstrDeclares = pstrDeclares & "'Declare Function Ctl3dUnregister Lib " & Chr(34) & "CTL3DV2.DLL" & Chr(34) & " (ByVal hInstance As Integer) As Integer" & gstrCR & gstrCR End If Get3DDecl = pstrDeclares End Function Function GetConsts (Indent As String, ConstStyle As String) As String Dim pstrMsgBoxIni As String Dim pstrIncConst As String Dim pstrConstType As String Dim pstrConstDef As String Dim pstrConstUse As String pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pstrIncConst = ReadIni("Code Options", "Include Const", pstrIncConst, pstrMsgBoxIni) pstrConstType = ReadIni("Code Options", "Const Type", pstrConstType, pstrMsgBoxIni) If pstrConstType = "Local" Then ' Get the const for the type of button Select Case gintButtonstyle Case 0 pstrConstDef = Indent & "Const MB_OK = 0 ' OK button only" & gstrCR pstrConstUse = "MB_OK +" Case 1 pstrConstDef = Indent & "Const MB_OKCANCEL = 1 ' OK and Cancel buttons" & gstrCR pstrConstUse = "MB_OKCANCEL +" Case 2 pstrConstDef = Indent & "Const MB_ABORTRETRYIGNORE = 2 ' Abort, Retry, and Ignore buttons" & gstrCR pstrConstUse = "MB_ABORTRETRYIGNORE +" Case 3 pstrConstDef = Indent & "Const MB_YESNOCANCEL = 3 ' Yes, No, and Cancel buttons" & gstrCR pstrConstUse = "MB_YESNOCANCEL +" Case 4 pstrConstDef = Indent & "Const MB_YESNO = 4 ' Yes and No buttons" & gstrCR pstrConstUse = "MB_YESNO +" Case 5 pstrConstDef = Indent & "Const MB_RETRYCANCEL = 5 ' Retry and Cancel buttons" & gstrCR pstrConstUse = "MB_RETRYCANCEL +" End Select ' Get the const for the default button Select Case gintDefault Case 0 If gintButtonstyle <> 0 Then pstrConstDef = pstrConstDef & Indent & "Const MB_DEFBUTTON1 = 0 ' First button is default" & gstrCR pstrConstUse = pstrConstUse & " MB_DEFBUTTON1 +" End If Case 256 pstrConstDef = pstrConstDef & Indent & "Const MB_DEFBUTTON2 = 256 ' Second button is default" & gstrCR pstrConstUse = pstrConstUse & " MB_DEFBUTTON2 +" Case 512 pstrConstDef = pstrConstDef & Indent & "Const MB_DEFBUTTON3 = 512 ' Third button is default" & gstrCR pstrConstUse = pstrConstUse & " MB_DEFBUTTON3 +" End Select ' Get the const for the type if icon Select Case gintIconstyle Case 16 pstrConstDef = pstrConstDef & Indent & "Const MB_ICONSTOP = 16 ' Critical message" & gstrCR pstrConstUse = pstrConstUse & " MB_ICONSTOP +" Case 32 pstrConstDef = pstrConstDef & Indent & "Const MB_ICONQUESTION = 32 ' Warning query" & gstrCR pstrConstUse = pstrConstUse & " MB_ICONQUESTION +" Case 48 pstrConstDef = pstrConstDef & Indent & "Const MB_ICONEXCLAMATION = 48 ' Warning message" & gstrCR pstrConstUse = pstrConstUse & " MB_ICONEXCLAMATION +" Case 64 pstrConstDef = pstrConstDef & Indent & "Const MB_ICONINFORMATION = 64 ' Information message" & gstrCR pstrConstUse = pstrConstUse & " MB_ICONINFORMATION +" End Select ' Get the const for the modal style Select Case gintModal Case 0 pstrConstDef = pstrConstDef & Indent & "Const MB_APPLMODAL = 0 ' Application Modal Message Box" & gstrCR pstrConstUse = pstrConstUse & " MB_APPLMODAL" Case Else pstrConstDef = pstrConstDef & Indent & "Const MB_SYSTEMMODAL = 4096 'System Modal" & gstrCR pstrConstUse = pstrConstUse & " MB_SYSTEMMODAL" End Select pstrConstDef = pstrConstDef & gstrCR & gstrCR Else ' None GetConsts = "" pstrConstUse = Str(gintDefault + gintIconstyle + gintButtonstyle + gintModal) End If ConstStyle = pstrConstUse If Trim(pstrIncConst) = "1" Then GetConsts = pstrConstDef Else GetConsts = "" End If End Function Function GetDims (Indent As String, IncludeReturn As Integer, TheAnswer As String, TheMessage As String, TheStyle As String, TheTitle As String, TheRLF As String) As String Dim pstrWorking As String If TheStyle <> "" Then pstrWorking = Indent & "Dim " & TheStyle & " as integer" & gstrCR End If If CodeOpt3D(1).Value Then ' If function call pstrWorking = pstrWorking & Indent & "Dim " & TheAnswer & " as integer" & gstrCR End If If TheMessage <> "" Then pstrWorking = pstrWorking & Indent & "Dim " & TheMessage & " as string" & gstrCR End If If Len(gstrTheTitle) And TheTitle <> "" Then ' If there is a title add it's dim pstrWorking = pstrWorking & Indent & "Dim " & TheTitle & " as string" & gstrCR End If If IncludeReturn Then pstrWorking = pstrWorking & Indent & "Dim " & TheRLF & " as string" & gstrCR pstrWorking = pstrWorking & "" & gstrCR pstrWorking = pstrWorking & Indent & TheRLF & " = Chr$(13) & Chr$(10)" & gstrCR Else pstrWorking = pstrWorking & "" & gstrCR End If GetDims = pstrWorking End Function Function GetGloCon () As String Dim pstrMsgBoxIni As String Dim pstrIncConst As String Dim pstrConstType As String Dim pstrConstDef As String pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pstrIncConst = ReadIni("Code Options", "Include Const", pstrIncConst, pstrMsgBoxIni) pstrConstType = ReadIni("Code Options", "Const Type", pstrConstType, pstrMsgBoxIni) pstrConstDef = "" If Trim(pstrIncConst) = "1" And pstrConstType = "Global" Then pstrConstDef = "' MsgBox parameters" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_OK = 0 ' OK button only" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_OKCANCEL = 1 ' OK and Cancel buttons" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_ABORTRETRYIGNORE = 2 ' Abort, Retry, and Ignore buttons" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_YESNOCANCEL = 3 ' Yes, No, and Cancel buttons" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_YESNO = 4 ' Yes and No buttons" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_RETRYCANCEL = 5 ' Retry and Cancel buttons" & gstrCR & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_ICONSTOP = 16 ' Critical message" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_ICONQUESTION = 32 ' Warning query" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_ICONEXCLAMATION = 48 ' Warning message" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_ICONINFORMATION = 64 ' Information message" & gstrCR & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_DEFBUTTON1 = 0 ' First button is default" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_DEFBUTTON2 = 256 ' Second button is default" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_DEFBUTTON3 = 512 ' Third button is default" & gstrCR & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_APPLMODAL = 0 ' Application Modal Message Box" & gstrCR pstrConstDef = pstrConstDef & "Global Const MB_SYSTEMMODAL = 4096 'System Modal" & gstrCR & gstrCR pstrConstDef = pstrConstDef & "' MsgBox return values" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDOK = 1 ' OK button pressed" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDCANCEL = 2 ' Cancel button pressed" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDABORT = 3 ' Abort button pressed" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDRETRY = 4 ' Retry button pressed" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDIGNORE = 5 ' Ignore button pressed" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDYES = 6 ' Yes button pressed" & gstrCR pstrConstDef = pstrConstDef & "Global Const IDNO = 7 ' No button pressed" & gstrCR & gstrCR & gstrCR End If GetGloCon = pstrConstDef End Function Function GetIndent (MsgBoxIni As String) As String GetIndent = String(Trim(ReadIni("Code Options", "Tab Stop", "2", MsgBoxIni)), " ") End Function Function GetMsgBoxCall (Indent As String, TheAnswer As String, TheMessage As String, TheStyle As String, TheTitle As String) As String Dim pstrMsgBox As String Dim pstrMsgBoxIni As String Dim pstr3DUse As String Dim pstr3DSubName As String Dim pstrTheMessage As String pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") pstr3DUse = ReadIni("Code Options", "Use 3D", "Never", pstrMsgBoxIni) pstr3DSubName = ReadIni("Code Options", "3D Code Name", "Turn3dOnOff", pstrMsgBoxIni) ' Can not set form UI need to change ' this can cause some ugly errors But..... If TheMessage = "" Then If InStr(gstrRawMessage, Chr(10)) Then pstrTheMessage = "You have a line brake in your message and have no variable for the message. This will most likely cause a problem with the code produced." Call Turn3dOnOff MsgBox pstrTheMessage, 64, "MsgBox" Call Turn3dOnOff End If TheMessage = Chr(34) & gstrRawMessage & Chr(34) End If If CodeOpt3D(0).Value Then ' If statement is selected pstrMsgBox = Indent & "MsgBox " & TheMessage & ", " & TheStyle If Len(gstrTheTitle) Then ' If there is a title add it to the msgbox call pstrMsgBox = pstrMsgBox & ", " & TheTitle End If pstrMsgBox = pstrMsgBox & gstrCR Else ' If function is selected pstrMsgBox = Indent & TheAnswer & " = MsgBox(" & TheMessage & ", " & TheStyle If Len(gstrTheTitle) Then ' If there is a title add it to the msgbox call pstrMsgBox = pstrMsgBox & ", " & TheTitle End If pstrMsgBox = pstrMsgBox & ")" & gstrCR End If If pstr3DUse = "Always" Then pstrMsgBox = Indent & "Call " & pstr3DSubName & gstrCR & pstrMsgBox pstrMsgBox = pstrMsgBox & Indent & "Call " & pstr3DSubName & gstrCR End If GetMsgBoxCall = pstrMsgBox End Function Function GetMsgBoxCode () As String Dim pintTheAnswer As Integer Dim pintIncludeRet As Integer Dim pstrTheStyle As String Dim pstrCR As String Dim pstrHeader As String Dim pstrHandler As String Dim pstrTheAnswerName As String Dim pstrTheMessageName As String Dim pstrTheStyleName As String Dim pstrTheTitleName As String Dim pstrTheRLF As String Dim pstrMsgBoxIni As String Dim pstrIndent As String pstrCR = gstrCR & gstrCR ' Get the app's ini file name and location pstrMsgBoxIni = MakePath((app.Path), app.EXEName & ".ini") ' Get all Variable names from the ini file Call GetVariablesNames(pstrMsgBoxIni, pstrTheAnswerName, pstrTheMessageName, pstrTheStyleName, pstrTheTitleName, pstrTheRLF) ' Get a string of blanks the size of the Tab Stop option pstrIndent = GetIndent(pstrMsgBoxIni) ' Get the message ready for display gstrTheMessage = SetMessageUp(pstrIndent, pstrTheMessageName, pstrTheRLF) ' Find if we need to include the return line feed in the code pintIncludeRet = InStr(gstrTheMessage, pstrTheRLF) ' Get global constants if needed pstrHeader = GetGloCon() ' Get Declares for 3D if needed pstrHeader = pstrHeader & Get3DDecl() ' Get the required constants ' and Bild the style from default button the icon style and what buttins to use pstrHeader = pstrHeader & GetConsts(pstrIndent, pstrTheStyle) ' Get the required dimension statements and put in final code pstrHeader = pstrHeader & GetDims(pstrIndent, pintIncludeRet, pstrTheAnswerName, pstrTheMessageName, pstrTheStyleName, pstrTheTitleName, pstrTheRLF) ' Add the message definition to the final code If pstrTheMessageName <> "" Then pstrHeader = pstrHeader & gstrTheMessage End If ' Add the style definition to the final code If pstrTheStyleName <> "" Then pstrHeader = pstrHeader & pstrIndent & pstrTheStyleName & " = " & pstrTheStyle & gstrCR Else pstrTheStyleName = pstrTheStyle End If ' If there is a titel If Len(gstrTheTitle) Then If pstrTheTitleName <> "" Then ' Add the title definition to the final code pstrHeader = pstrHeader & pstrIndent & pstrTheTitleName & " = " & gstrQ & gstrTheTitle & gstrQ & gstrCR Else pstrTheTitleName = gstrQ & gstrTheTitle & gstrQ End If End If ' Get and add the msgbox call to the final code according to what type of call is to be made pstrHeader = pstrHeader & GetMsgBoxCall(pstrIndent, pstrTheAnswerName, pstrTheMessageName, pstrTheStyleName, pstrTheTitleName) If CodeOpt3D(1).Value Then ' If function is selected ' Build function handler Select Case gintButtonstyle Case 5 pstrHandler = pstrIndent & "If " & pstrTheAnswerName & " = 4 Then 'Answered Retry" & pstrCR pstrHandler = pstrHandler & pstrIndent & "Else 'Answered Cancel" & pstrCR & pstrIndent & "End If" & gstrCR Case 4 pstrHandler = pstrIndent & "If " & pstrTheAnswerName & " = 6 Then 'Answered Yes" & pstrCR pstrHandler = pstrHandler & pstrIndent & "Else 'Answered No" & pstrCR & pstrIndent & "End If" & gstrCR Case 3 pstrHandler = pstrIndent & "Select Case " & pstrTheAnswerName & gstrCR & pstrIndent & pstrIndent & "Case 7 'Pressed No" & pstrCR pstrHandler = pstrHandler & pstrIndent & pstrIndent & "Case 6 'Answered Yes" & pstrCR pstrHandler = pstrHandler & pstrIndent & pstrIndent & "Case Else 'Answered Cancel" & pstrCR & pstrIndent & "End Select" & gstrCR Case 2 pstrHandler = pstrIndent & "Select Case " & pstrTheAnswerName & gstrCR & pstrIndent & pstrIndent & "Case 5 'Pressed Ignore" & pstrCR pstrHandler = pstrHandler & pstrIndent & pstrIndent & "Case 4 'Answered Retry" & pstrCR pstrHandler = pstrHandler & pstrIndent & pstrIndent & "Case Else 'Answered Abort" & pstrCR & pstrIndent & "End Select" & gstrCR Case 1 pstrHandler = pstrIndent & "If " & pstrTheAnswerName & " = 1 Then 'Answered OK" & pstrCR pstrHandler = pstrHandler & pstrIndent & "Else 'Answered Cancel" & pstrCR & pstrIndent & "End If" & gstrCR Case Else pstrHandler = "" End Select ' Put handler on te final code pstrHeader = pstrHeader & pstrHandler End If ' Get 3D sub if nessary pstrHeader = pstrHeader & Get3DCode(pstrIndent) GetMsgBoxCode = pstrHeader End Function Sub GetVariablesNames (MsgBoxIni As String, TheAnswer As String, TheMessage As String, TheStyle As String, TheTitle As String, TheRLF As String) TheTitle = ReadIni("Code Options", "Title Name", "pstrTheTitle", MsgBoxIni) TheMessage = ReadIni("Code Options", "Msg Name", "pstrTheMessage", MsgBoxIni) TheStyle = ReadIni("Code Options", "Style Name", "pintTheStyle", MsgBoxIni) TheAnswer = ReadIni("Code Options", "Answer Name", "pintTheAnswer", MsgBoxIni) TheRLF = ReadIni("Code Options", "Return Name", "pstrRLF", MsgBoxIni) If TheAnswer = "" Then TheAnswer = "pintTheAnswer" If TheRLF = "" Then TheRLF = "pstrRLF" End Sub Sub IconPic_Click (Index As Integer) Call SetIconPic(Index) End Sub Sub IconPic_GotFocus (Index As Integer) Call SetIconPic(Index) End Sub Sub IcPicLabel_Click (Index As Integer) IconPic(Index).SetFocus End Sub Sub optDefButton_Click (Index As Integer, Value As Integer) ' Set Global to the Default button setting gintDefault = Index End Sub Sub optModal_Click (Index As Integer, Value As Integer) ' Set Global to the modal setting gintModal = Index End Sub Sub SetIconPic (Index As Integer) Dim pintCount As Integer gintIconstyle = Index IconPic(gintIconstyle).BorderStyle = 1 For pintCount = 0 To 64 Step 16 If IconPic(pintCount).Index <> gintIconstyle Then IconPic(pintCount).BorderStyle = 0 End If Next pintCount End Sub Function SetMessageUp (Indent As String, TheMessageName As String, TheRLF As String) As String Dim pintAReturn As Integer Dim pintPass As Integer Dim pstrCReturn As String Dim pstrTempMessage As String pstrCReturn = gstrQ & " & " & TheRLF pstrTempMessage = gstrRawMessage ' If message is more then one line long pintAReturn = InStr(pstrTempMessage, Chr$(13)) If pintAReturn > 0 Then pintPass = 0 While pintAReturn <> 0 If Len(pstrTempMessage) > 2 Then If pintPass = 0 Then gstrTheMessage = Indent & TheMessageName & " = " & gstrQ & Left$(pstrTempMessage, pintAReturn - 1) & pstrCReturn & gstrCR Else gstrTheMessage = gstrTheMessage & Indent & TheMessageName & " = " & TheMessageName & " & " & gstrQ & Left$(pstrTempMessage, pintAReturn - 1) & pstrCReturn & gstrCR End If pintPass = pintPass + 1 pstrTempMessage = Mid$(pstrTempMessage, pintAReturn + 2) End If pintAReturn = InStr(pstrTempMessage, Chr$(13)) Wend SetMessageUp = gstrTheMessage & Indent & TheMessageName & " = " & TheMessageName & " & " & gstrQ & pstrTempMessage & pstrCReturn & gstrCR ElseIf Len(pstrTempMessage) > 150 Then pintPass = 0 While Len(pstrTempMessage) > 150 If pintPass = 0 Then gstrTheMessage = Indent & TheMessageName & " = & " & gstrQ & Left$(pstrTempMessage, 150) & gstrQ & gstrCR Else gstrTheMessage = gstrTheMessage & Indent & TheMessageName & " = " & TheMessageName & " & " & gstrQ & Left$(pstrTempMessage, 150) & gstrQ & gstrCR End If pintPass = pintPass + 1 pstrTempMessage = Mid$(pstrTempMessage, 151) Wend SetMessageUp = gstrTheMessage & Indent & TheMessageName & " = " & TheMessageName & " & " & gstrQ & pstrTempMessage & gstrQ & gstrCR Else SetMessageUp = Indent & TheMessageName & " = " & gstrQ & pstrTempMessage & gstrQ & gstrCR End If End Function 
(.txt)